home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu634.dms / pu634.adf / GENIES / PieChart.pdrx < prev    next >
Text File  |  1994-09-06  |  12KB  |  417 lines
  1. /*
  2. Copyright 1992 StarTeck. All rights reserved.
  3.  
  4. This Genie will create a pie chart !!!
  5.    Just answer the prompts.
  6. */
  7.  
  8.  
  9.  
  10. call pdm_AutoUpdate(0)
  11. cr = '0a'x
  12.  
  13. numeric digits 5
  14.  
  15. msg = PDSetup.rexx(2,0) /* set-up librarys */
  16. units = getclip(pds_units)
  17. if msg ~= 1 then exit_msg(msg)
  18.  
  19. pi2 = 6.28318
  20.  
  21. call pdm_unselectobj()
  22.  
  23.  
  24. /************ MAINLINE *******************/
  25.  
  26. call GetNumSlices()
  27.  
  28. call PercentOrDegrees()
  29.  
  30.  
  31. If Percent = 1 then
  32.  call Percent()
  33.  
  34.  else
  35.   call Degrees()
  36.  
  37. /*trace ?results*/
  38. call GetPieDia()
  39.  
  40. call GetCenterPie()
  41.  
  42. call GetColors()
  43.  
  44. call DrawPie()
  45.  
  46. call exit_msg()
  47.  
  48.  
  49.  
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58. /* functions functions functions */
  59. /* functions functions functions */
  60. /* functions functions functions */
  61.  
  62.  
  63.  
  64. /*****************************************************************
  65. Prompt for Percent or Degrees                                    */
  66.  
  67.  
  68. PercentOrDegrees:
  69.  
  70. Percent = 'NIL'
  71.  
  72. PercentDegree = pdm_Inform(3,'Choose input method...','DEGREES','cancel','PERCENT')
  73.  
  74. if PercentDegree = 1 | PercentDegree = -1 then exit_msg()
  75. if PercentDegree = 0 then Percent = 0
  76. if PercentDegree = 2 then Percent = 1
  77.  
  78. return /* end of PercentOrDegrees function */
  79.  
  80.  
  81.  
  82. /*****************************************************************
  83. Get Number of Slices                                             */
  84.  
  85. GetNumSlices:
  86.  
  87. NumSlices = getclip(NumberOfSlices)
  88. if NumSlices = '' then NumSlicesPrompt = 'Number of slices:'3
  89.    else
  90.       NumSlicesPrompt = 'Number of slices:'NumSlices
  91.  
  92.  
  93. NumSlices = pdm_getform('Input number of slices...',1,NumSlicesPrompt)
  94.       if NumSlices = '' then exit_msg()
  95.       if ~(datatype(NumSlices,n)) then exit_msg(Invalid entry...)
  96.       if NumSlices < 1 then exit_msg('You must have at least one slice...')
  97.       Round = NumSlices + .5
  98.       NumSlices = trunc(Round)
  99.       call SetClip(NumberOfSlices,NumSlices)
  100. return /* end of GetNumSlices function */
  101.  
  102.  
  103.  
  104. /******************************************************************
  105. Get Pie Diameter                                                  */
  106.  
  107. GetPieDia:
  108.  
  109. MRUdiaClip = getclip(PieDiaClip)
  110. if MRUdiaClip = '' then DiaPrompt = 'DIAMETER:'3
  111.    else
  112.       DiaPrompt = 'DIAMETER:'MRUdiaClip
  113.       
  114. Dia = 0
  115. Do while Dia <= 0
  116. Dia = pdm_getform('Input the pie''s diameter...',1,DiaPrompt)
  117.       if Dia = '' then exit_msg()
  118.       if ~(datatype(Dia,n)) then exit_msg(Invalid entry...)
  119.       if Dia <= 0 then 
  120.          call pdm_Inform(1,'Diameter must be greater than 0...','RETRY')
  121.       end /* end do */
  122. rad = (Dia / 2)
  123. call setclip(PieDiaClip,Dia)
  124.  
  125. return /* end of GetPieDia function */
  126.  
  127.  
  128. *****************************************************************
  129. Get Center of pie                                                 */
  130.  
  131. GetCenterPie:
  132.  
  133. center = PDM_clickellipse("Where do you want the center of the pie?",Rad,Rad)
  134. if center = '' then exit_msg()
  135. XCenter = word(center,1)
  136. YCenter = word(center,2)
  137.  
  138. return /* end of GetCenterPie function */
  139.  
  140.  
  141. /******************************************************************
  142. Get Colors                                                          */
  143.  
  144. GetColors:
  145.  
  146. UserColors = pdm_Inform(2,'Choose colors with genies help?','YES','NO')
  147. if UserColors = 0 then 
  148.     call Colors()
  149.  
  150. return /* end of GetColors function */
  151.  
  152. /******************************************************************
  153. Draw Pie                                                          */
  154.  
  155.  
  156. DrawPie:
  157.  
  158. call pdm_ShowStatus("Working...")
  159.  
  160. Offset = (pi2 / 4)
  161. Offset2 = (pi2 * .75)
  162.  
  163. do i = 1 to NumSlices
  164.  /************************START OF SLICE*********/
  165.  
  166.     call pdm_InitPlot(XCenter,YCenter,1,1,0,'Slice#'i) /* initiate incremental start-point */
  167.  
  168.     call pdm_PlotLine(0" "0) /* P1 */
  169.  
  170.    /* get P2 coords */
  171.     TotalDeg = 0
  172.         do j = 1 to (i-1)
  173.             Totaldeg = (TotalDeg + DegSlice.j)
  174.             end
  175.     TotalDeg = (TotalDeg * .0174533) /* pi divided by 180 */
  176.     Point2X = cos(TotalDeg) * rad
  177.     Point2Y = -sin(TotalDeg) * rad
  178.  
  179.     DegSlice.i.Radians = (DegSlice.i * .0174533) /* 1 deg. = .0174533 radians */
  180.     if DegSlice.i.Radians > 1.5707963 then do
  181.         TanLength = (.3516051 * (1.5707963 * rad)) /* Get length of radius */
  182.         Tan1X = cos(Offset + TotalDeg) * TanLength
  183.         Tan1Y = -sin(Offset + TotalDeg) * TanLength
  184.         call pdm_PlotBezier(Point2X" "Point2Y" "0 0 Tan1X Tan1Y)
  185.         TotalDeg = TotalDeg + 1.5707963
  186.  
  187.         Do while DegSlice.i.Radians > 1.5707963
  188.             InterPX = cos(TotalDeg) * rad
  189.             InterPY = -sin(TotalDeg) * rad
  190.             TanLength = (.3516051 * (1.5707963 * rad)) /* Get length of radius */
  191.             InterTan1X = cos(Offset2 + TotalDeg) * TanLength
  192.             InterTan1Y = -sin(Offset2 + TotalDeg) * TanLength
  193.  
  194.             DegSlice.i.Radians = (DegSlice.i.radians - 1.5707063)
  195.             if DegSlice.i.Radians < 1.5707963 then                 /* look ahead */
  196.                   TanLength = (.3516051 * (DegSlice.i.radians * rad))
  197.             InterTan2X = cos(Offset + TotalDeg) * TanLength
  198.             InterTan2Y = -sin(Offset + TotalDeg) * TanLength
  199.             call pdm_PlotBezier(InterPX" "InterPY" "InterTan1X InterTan1Y InterTan2X InterTan2Y)
  200.             if DegSlice.i.Radians > 1.5707963 then
  201.                TotalDeg = TotalDeg + 1.5707963
  202.             End /* do loop */
  203.         End /* if do */
  204.  
  205.         Else do
  206.             TanLength = (.3516051 * (DegSlice.i.radians * rad))
  207.             Tan1X = cos(Offset + TotalDeg) * TanLength
  208.             Tan1Y = -sin(Offset + TotalDeg) * TanLength
  209.             call pdm_PlotBezier(Point2X" "Point2Y" "0 0 Tan1X Tan1Y)
  210.             End /* if else do*/
  211.  
  212.  
  213.    /* get P3 coords */
  214.     TanLength = (.3516051 * (DegSlice.i.radians * rad))
  215.     Totaldeg = (TotalDeg + DegSlice.i.radians)
  216.     Point3X = cos(TotalDeg) * rad
  217.     Point3Y = -sin(TotalDeg) * rad
  218.  
  219.     Tan2X = cos(Offset2 + TotalDeg) * TanLength
  220.     Tan2Y = -sin(Offset2 + TotalDeg) * TanLength
  221.     call pdm_PlotBezier(Point3X" "Point3Y" " Tan2X Tan2Y 0 0)
  222.  
  223.     If UserColors = 0 then
  224.         call SetFillPattern(,1,ColorSlice#.i,,,,,)
  225.     call SetLineJoin(,3)
  226.     call SetLineWeight(,.5)
  227.     /* call SetLinePattern(0,) */
  228.     /* call SetLineColor(,rgb 15,15,15) */
  229.     call pdm_ClosePlot()
  230.     end
  231.  
  232.  
  233. return /* end of DrawPie function */
  234.  
  235.  
  236.  
  237.  
  238. /*****************************************************************
  239. Create Color list                                            */
  240.  
  241.  
  242. Colors:
  243.    colorlist = GetColorList()
  244.    if  ~(colorlist = '') then do
  245.        count = 1
  246.        pos   = index(colorlist, cr)
  247.  
  248.        do while pos > 0
  249.           count = count + 1
  250.           pos   = index(colorlist, cr, pos + 1)
  251.           end
  252.        end
  253.     else
  254.        exit_msg(Color palatte not found)
  255.  
  256.  
  257.     Do i = 1 to NumSlices
  258.        ColorSlice#.i = SelectFromList('Choose slice # 'i' color...',30,count,2,colorlist)
  259.        if ColorSlice#.i = '' then exit_msg() 
  260.        end /* end do */
  261.  
  262. return /* end of Colors function */
  263.  
  264.  
  265. /*****************************************************************
  266. Get Percent of Slices                                            */
  267.  
  268. Percent:
  269.  
  270. /* Next three lines for testing only */
  271. /*PercentSlice.1 = 10
  272. PercentSlice.2 = 30
  273. PercentSlice.3 = 60
  274. */
  275.  
  276.  
  277. TotalPercentCorrect = '1'
  278.  
  279.  
  280. Do while ~(TotalPercentCorrect = 0)  /* build percent list from scratch */
  281.    MRU = GetClip(SliceClip#.1)
  282.    if MRU = '' then do /* MRU most resently used */
  283.       PercentPrompt = 'Slice #1'
  284.       do i = 2 to (NumSlices-1)
  285.          PercentPrompt = PercentPrompt ||cr|| 'Slice #'i
  286.          end /* do */
  287.       if NumSlices > 1 then
  288.          PercentPrompt = PercentPrompt ||cr|| 'Slice #'NumSlices
  289.       end /* if then */
  290.  
  291.       else do         /* build percent list from MRU clips */
  292.          Percent#. = 'empty'
  293.          Percent#.1 = GetClip(SliceClip#.1)
  294.          Percent#.1 = (Percent#.1 / 3.6)  /* convert degrees to percent */
  295.          PercentPrompt = 'Slice #1:'Percent#.1
  296.          do i = 2 to (NumSlices-1)
  297.             Percent#.i = GetClip(SliceClip#.i)
  298.             If Percent#.i ~= '' then
  299.                Percent#.i = (Percent#.i / 3.6)  /* convert degrees to percent */ 
  300.             PercentPrompt = PercentPrompt ||cr|| 'Slice #'i':'Percent#.i
  301.             end
  302.          if NumSlices > 1 then do
  303.             Percent#.NumSlices = GetClip(SliceClip#.NumSlices)
  304.             If Percent#.NumSlices ~= '' then
  305.                Percent#.NumSlices = (Percent#.NumSlices / 3.6) /*convert degrees to percent */
  306.             PercentPrompt = PercentPrompt ||cr|| 'Slice #'NumSlices':'Percent#.NumSlices
  307.            end /* if then */
  308.          end /* if else */
  309.  
  310. Percent = ''
  311. Percent = pdm_getform('Input the Percent of each slice...',7,PercentPrompt)
  312.       if Percent = '' then exit_msg()
  313.  
  314.       TotalSlicePercent = 0
  315.       PercentSlice. = 'empty'
  316.       do i = 1 to NumSlices
  317.            parse var Percent PercentSlice.i (cr) Percent
  318.            if ~(datatype(PercentSlice.i,n)) then exit_msg(Invalid entry...)
  319.            if PercentSlice.i < 0 then exit_msg('Percent must be greater than 0...')
  320.            TotalSlicePercent = TotalSlicePercent + PercentSlice.i
  321.            DegSlice.i = (PercentSlice.i * 3.6) /* convert to degrees */
  322.      call SetClip(SliceClip#.i,DegSlice.i)
  323.            end
  324.  
  325. if ~(TotalSlicePercent = 100) then do
  326.    PercentCorrectPrompt = 'All your slices added together equal 'TotalSlicePercent' Percent! Is this correct?'
  327.    /* 'Is this correct?' */
  328.    TotalPercentCorrect = pdm_Inform(2,PercentCorrectPrompt,'YES','NO RE-INPUT')
  329.    end /* if then */
  330.    else
  331.       TotalPercentCorrect = 0
  332.  
  333. end /* do while */
  334.  
  335. return /* end of Percent function */
  336.  
  337.  
  338.  
  339. /*****************************************************************
  340. Get Degrees of Slices                                            */
  341.  
  342. Degrees:
  343.  
  344.  
  345. /* Next three lines for testing only */
  346. /*DegSlice.1 = 180
  347. DegSlice.2 = 45
  348. DegSlice.3 = 80
  349. */
  350.  
  351.  
  352. TotalDegCorrect = '1'
  353.  
  354.  
  355. Do while ~(TotalDegCorrect = 0)
  356.    MRU = GetClip(SliceClip#.1)
  357.    if MRU = '' then do /* MRU most resently used */
  358.       DegreesPrompt = 'Slice #1'
  359.       do i = 2 to (NumSlices-1)
  360.          DegreesPrompt = DegreesPrompt ||cr|| 'Slice #'i
  361.          end /* do */
  362.       if NumSlices > 1 then
  363.          DegreesPrompt = DegreesPrompt ||cr|| 'Slice #'NumSlices
  364.       end /* if then */
  365.  
  366.       else do
  367.          Deg#. = 'empty'
  368.          Deg#.1 = GetClip(SliceClip#.1)
  369.          DegreesPrompt = 'Slice #1:'Deg#.1
  370.          do i = 2 to (NumSlices-1)
  371.             Deg#.i = GetClip(SliceClip#.i)
  372.             DegreesPrompt = DegreesPrompt ||cr|| 'Slice #'i':'Deg#.i
  373.             end
  374.          if NumSlices > 1 then do
  375.             Deg#.NumSlices = GetClip(SliceClip#.NumSlices)
  376.             DegreesPrompt = DegreesPrompt ||cr|| 'Slice #'NumSlices':'Deg#.NumSlices
  377.            end /* if then */
  378.          end /* if else */
  379.  
  380. Degrees = ''
  381. Degrees = pdm_getform('Input the degrees of each slice...',7,DegreesPrompt)
  382.       if Degrees = '' then exit_msg()
  383.  
  384.       TotalSliceDeg = 0
  385.       DegSlice. = 'empTy'
  386.       do i = 1 to NumSlices
  387.            parse var Degrees DegSlice.i (cr) Degrees
  388.            if ~(datatype(DegSlice.i,n)) then exit_msg(Invalid entry...)
  389.            if DegSlice.i < 0 then exit_msg('Degrees must be greater than 0...')
  390.            TotalSliceDeg = TotalSliceDeg + DegSlice.i
  391.            call SetClip(SliceClip#.i,DegSlice.i)
  392.            end
  393.  
  394. if ~(TotalSliceDeg = 360) then do
  395.    DegCorrectPrompt = 'All your slices added together equal 'TotalSliceDeg' degree(s)! Is this correct?'
  396.    /* 'Is this correct?' */
  397.    TotalDegCorrect = pdm_Inform(2,DegCorrectPrompt,'YES','NO RE-INPUT')
  398.    end /* if then */
  399.    else
  400.       TotalDegCorrect = 0
  401.  
  402. end /* do while */
  403.  
  404. return /* end of Degrees function */
  405.  
  406.  
  407.  
  408. exit_msg:
  409. do
  410.         parse arg message
  411.         if message ~= '' then
  412.             call pdm_Inform(1, message,)
  413.         call pdm_ClearStatus()
  414.         call pdm_SetUnits(units)
  415.         call pdm_AutoUpdate(1)
  416.         exit
  417. end